home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / FLOPPY / SICL / DISK2 / HPIOLIBS.2 / sicl95 / vb / samples / iocmd / iocmd.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-01-29  |  7.0 KB  |  194 lines
  1. VERSION 4.00
  2. Begin VB.Form IOCMD 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Instrument I/O Command Utility"
  6.    ClientHeight    =   3690
  7.    ClientLeft      =   1035
  8.    ClientTop       =   3810
  9.    ClientWidth     =   6930
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   0
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   4050
  21.    Icon            =   "IOCMD.frx":0000
  22.    Left            =   975
  23.    LinkTopic       =   "Form1"
  24.    ScaleHeight     =   3690
  25.    ScaleWidth      =   6930
  26.    Top             =   3510
  27.    Width           =   7050
  28.    Begin VB.TextBox txtCommand 
  29.       Appearance      =   0  'Flat
  30.       Height          =   288
  31.       Left            =   2280
  32.       TabIndex        =   5
  33.       Text            =   "*IDN?"
  34.       Top             =   1560
  35.       Width           =   3972
  36.    End
  37.    Begin VB.CommandButton cmdOutputCmd 
  38.       Appearance      =   0  'Flat
  39.       BackColor       =   &H80000005&
  40.       Caption         =   "Output Command"
  41.       Default         =   -1  'True
  42.       Height          =   492
  43.       Left            =   2520
  44.       TabIndex        =   4
  45.       Top             =   2760
  46.       Width           =   1812
  47.    End
  48.    Begin VB.TextBox txtResponse 
  49.       Appearance      =   0  'Flat
  50.       Height          =   288
  51.       Left            =   2280
  52.       TabIndex        =   1
  53.       Top             =   2160
  54.       Width           =   4332
  55.    End
  56.    Begin VB.TextBox txtInstAddr 
  57.       Appearance      =   0  'Flat
  58.       BackColor       =   &H00FFFFFF&
  59.       Height          =   288
  60.       Left            =   2280
  61.       TabIndex        =   0
  62.       Text            =   "hpib7,0"
  63.       Top             =   960
  64.       Width           =   2412
  65.    End
  66.    Begin VB.Label Label3 
  67.       Appearance      =   0  'Flat
  68.       AutoSize        =   -1  'True
  69.       BackColor       =   &H0000FFFF&
  70.       Caption         =   "Command :"
  71.       ForeColor       =   &H80000008&
  72.       Height          =   195
  73.       Left            =   240
  74.       TabIndex        =   6
  75.       Top             =   1560
  76.       Width           =   1095
  77.    End
  78.    Begin VB.Label Label2 
  79.       Appearance      =   0  'Flat
  80.       AutoSize        =   -1  'True
  81.       BackColor       =   &H0000FFFF&
  82.       Caption         =   "Response:"
  83.       ForeColor       =   &H80000008&
  84.       Height          =   195
  85.       Left            =   240
  86.       TabIndex        =   3
  87.       Top             =   2160
  88.       Width           =   1095
  89.    End
  90.    Begin VB.Label Label1 
  91.       Appearance      =   0  'Flat
  92.       AutoSize        =   -1  'True
  93.       BackColor       =   &H0000FFFF&
  94.       Caption         =   "Instrument Address:"
  95.       ForeColor       =   &H80000008&
  96.       Height          =   195
  97.       Left            =   240
  98.       TabIndex        =   2
  99.       Top             =   960
  100.       Width           =   1815
  101.    End
  102. Attribute VB_Name = "IOCMD"
  103. Attribute VB_Creatable = False
  104. Attribute VB_Exposed = False
  105. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  106. '  This routine uses the Standard Instrument Control
  107. '  Library to send commands to an instrument.  The address
  108. '  of the instrument is obtained from a Text box named
  109. '  txtInstAddr.  If the command is a SCPI query command
  110. '  then the response to the command will be read and
  111. '  displayed in the txtResponse Text box.
  112. '  Note that any SICL errors that occur are displayed in
  113. '  the txtResponse Text box.
  114. '  This routine is called each time the cmdOutputCmd Command
  115. '  button is clicked.
  116. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  117. Private Sub cmdOutputCmd_Click()
  118.    Dim id As Integer                ' device session id
  119.    Dim readbuf As String * 128      ' buffer used for iread
  120.    Dim commandstr As String * 128   ' command passed to instrument
  121.    Dim index As Integer             ' used to parse SCPI error message
  122.    Dim nargs As Integer             ' # args converted by format string
  123. '  Set up an error handler within this subroutine that will get
  124. '  called if a SICL error occurs.
  125.    On Error GoTo ErrorHandler
  126. '  Disable the button used to initiate I/O while I/O is
  127. '  being performed.
  128.    cmdOutputCmd.Enabled = False
  129. '  Clear the response string in the txtResponse TextBox.
  130.    txtResponse.Text = ""
  131. '  Open a device session using the device address contained in
  132. '  the Text field of the txtInstAddr TextBox.
  133.    id = iopen(txtInstAddr.Text)
  134. '  Set the I/O timeout value for this session to 1 second.
  135.    Call itimeout(id, 1000)
  136. '  Clear the error/event queue for the instrument.  This allows
  137. '  us to query the instrument after sending a command to see if
  138. '  the command was accepted.
  139.    nargs = ivprintf(id, "*CLS" + Chr$(10))
  140. '  Write the command to the instrument terminated by a linefeed.
  141.    commandstr = txtCommand.Text + Chr$(10)
  142.    nargs = ivprintf(id, commandstr)
  143. '  If the command is a SCPI query command ending in '?',
  144. '  then read and display the response to the command.
  145.    If InStr(txtCommand.Text, "?") Then
  146.       nargs = ivscanf(id, "%128t", readbuf)
  147.    '  Strip out returns and line feeds from the response string.
  148.       readbuf = strip_crlf(readbuf)
  149.    '  Display the response string in the Text field of the
  150.    '  txtResponse TextBox.
  151.       txtResponse.Text = readbuf
  152.    End If
  153. '  Query the instrument to see if the command was accepted
  154.    nargs = ivprintf(id, "SYST:ERR?" + Chr$(10))
  155.    nargs = ivscanf(id, "%128t", readbuf)
  156. '  Strip out returns and line feeds from the response string.  Note
  157. '  that strip_crlf is a utility routine defined in SICL.BAS.
  158.    readbuf = strip_crlf(readbuf)
  159. '  The SCPI error # is separated by the error message by a ',' character
  160.    index = InStr(readbuf, ",")
  161.    If index <> 0 Then
  162.       If Val(Left$(readbuf, index - 1)) <> 0 Then
  163.          txtResponse.Text = "SCPI Error " + readbuf
  164.       End If
  165.    Else
  166. '     handle non-SCPI errors
  167.       txtResponse.Text = "Error " + readbuf
  168.    End If
  169. '  Close the device session.
  170.    Call iclose(id)
  171. '  Enable the button used to initiate I/O
  172.    cmdOutputCmd.Enabled = True
  173.    Exit Sub
  174. ErrorHandler:
  175. '  Display the error message in the txtResponse TextBox.
  176.    txtResponse.Text = "*** Error : " + Error$
  177. '  Close the device session if iopen was successful.
  178.    If id <> 0 Then
  179.       iclose (id)
  180.    End If
  181. '  Enable the button used to initiate I/O
  182.    cmdOutputCmd.Enabled = True
  183.    Exit Sub
  184. End Sub
  185. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  186. '  The following routine is called when the application's
  187. '  Start Up form is unloaded.  It calls siclcleanup to
  188. '  release resources allocated by SICL for this
  189. '  application.
  190. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  191. Private Sub Form_Unload(Cancel As Integer)
  192.    Call siclcleanup    ' Tell SICL to clean up for this task
  193. End Sub
  194.